home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / eos / sun-eos-debugger-extra.el.z / sun-eos-debugger-extra.el
Encoding:
Text File  |  1998-05-21  |  24.1 KB  |  855 lines
  1. ;;; sun-eos-debugger.el --- Implements the XEmacs/SPARCworks Debugger interface
  2.  
  3. ;; Copyright (C) Sun Microsystems, Inc.
  4.  
  5. ;; Maintainer:    Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
  6. ;; Author:      Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
  7.  
  8. ;; Keywords:    SPARCworks EOS Era on SPARCworks Debugger dbx
  9.  
  10. ;;; Commentary:
  11. ;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
  12.  
  13. ;;; Code:
  14.  
  15. ;; debugger buffer
  16.  
  17. (require 'eos-common   "sun-eos-common")
  18. (require 'eos-debugger "sun-eos-debugger")
  19. (require 'eos-menubar  "sun-eos-menubar")
  20.  
  21. (defvar eos::debugger-buffer "*Eos Debugger Log*"
  22.   "name of buffer where to log debugger activity; see eos::use-debugger-buffer")
  23. (defvar eos::dbx-buffer nil)
  24. (defvar eos::key-mode 'none "Style of key mode interaction for Eos")
  25.  
  26. (defun eos::ensure-debugger-buffer ()
  27.   ;; will ensure a debugger buffer, with the proper major mode
  28.   (let ((buf (get-buffer eos::debugger-buffer)))
  29.     (if buf
  30.     (switch-to-buffer buf)
  31.       (setq buf (get-buffer-create eos::debugger-buffer))
  32.       (set-buffer buf)
  33.       (eos::debugger-mode)
  34.       (toggle-read-only -1)        ; writeable
  35.       (eos::insert-string-as-extent "[Debugger] " t (get-face 'bold))
  36.       (toggle-read-only 1)        ; read-only
  37.       )))
  38.  
  39. (defun eos::synchronize-debugger-buffer ()
  40.   ;; ensure all views of this buffer are at the end
  41.   (eos::ensure-debugger-buffer)
  42.   (let ((x (point-max)))
  43.     (goto-char x)
  44.     (mapcar (function
  45.          (lambda (win)
  46.            (set-window-point win x)))
  47.         (get-buffer-window-list eos::debugger-buffer))
  48.     ))
  49.  
  50. (defvar eos::debugger-mode-map nil)
  51.  
  52. (if eos::debugger-mode-map
  53.     nil
  54.   (progn
  55.     (setq eos::debugger-mode-map (make-keymap))
  56.     (set-keymap-name eos::debugger-mode-map 'eos::debugger-mode-map)
  57.     (define-key eos::debugger-mode-map [(meta p)] 'eos::debugger-previous-cmd)
  58.     (define-key eos::debugger-mode-map [(meta n)] 'eos::debugger-next-cmd)
  59.     (define-key eos::debugger-mode-map [return] 'eos::debugger-send-cmd)
  60.     ))
  61.  
  62. (defun eos::debugger-mode ()
  63.   (interactive)
  64.   "local mode"
  65.   (kill-all-local-variables)    
  66.   (setq major-mode 'eos::debugger-mode)
  67.   (setq mode-name "eos::debugger")
  68.   (setq truncate-lines t)
  69.   (set-syntax-table emacs-lisp-mode-syntax-table)
  70.   (use-local-map eos::debugger-mode-map))
  71.  
  72.  
  73. ;; Handling of command lists
  74.  
  75. (defvar eos::current-command nil "Current command navigated; as an extent")
  76. (defvar eos::last-command nil "last command sent to debugger, as an extent")
  77.  
  78. (defun eos::debugger-previous-cmd ()
  79.   ;; present the previous command
  80.   (interactive)
  81.   (save-excursion
  82.     (let ((xt nil))
  83.       (if (null eos::current-command)
  84.       (setq xt eos::last-command)
  85.     (setq xt (extent-property 
  86.           eos::current-command
  87.           'previous-command)))
  88.       (if xt
  89.       (progn
  90.         (eos::debugger-delete-last-cmd-line)
  91.         (goto-char (point-max))
  92.         (insert (buffer-substring
  93.              (extent-start-position xt)
  94.              (1- (extent-end-position xt)) ; remove <CR>
  95.              ))
  96.         (setq eos::current-command xt))
  97.     (error "no previous command")
  98.     ))
  99.     ))
  100.  
  101. (defun eos::debugger-next-cmd ()
  102.   ;; present the next command
  103.   (interactive)
  104.   (save-excursion
  105.     (let ((xt nil))
  106.       (if (null eos::current-command)
  107.       (error "no next command")
  108.     (setq xt (extent-property 
  109.           eos::current-command
  110.           'next-command)))
  111.       (eos::debugger-delete-last-cmd-line)
  112.       (if xt
  113.       (progn
  114.         (goto-char (point-max))
  115.         (insert (buffer-substring
  116.              (extent-start-position xt)
  117.              (1- (extent-end-position xt)) ; remove <CR>
  118.              ))
  119.         (setq eos::current-command xt))
  120.     (setq eos::current-command nil)
  121.     ))
  122.     ))
  123.  
  124. (defun eos::debugger-delete-last-cmd-line ()
  125.   ;; delete the last command line, not yet inputed, returns that cmd line
  126.   (goto-char (point-max))
  127.   (let ((e (point)))
  128.     (beginning-of-line)
  129.     (let* ((xt (extent-at (point)))
  130.        (p (extent-end-position xt))
  131.        (str (buffer-substring p e))
  132.        )
  133.       (delete-region p e)
  134.       str
  135.       )))
  136.  
  137. (defun eos::debugger-send-cmd ()
  138.   ;; send the message in the current line
  139.   (interactive)
  140.   (end-of-line)
  141.   (let ((e (point)))
  142.     (beginning-of-line)
  143.     (let* ((xt (extent-at (point)))
  144.        (p (extent-end-position xt))
  145.        (str (buffer-substring p e))
  146.        )
  147.       (delete-region p e)
  148.       (eos::send-spider-current-do-msg (concat str "\n"))
  149.       (goto-char (point-max))
  150.       (setq eos::current-command nil)
  151.       )))
  152.  
  153. ;; client
  154. ;;
  155.  
  156. (defun get-buffer-window-list (buffer)
  157.   ;; like get-buffer-window except that will generate a list of windows
  158.   ;; instead of just the first one"
  159.   (let* ((buf (get-buffer buffer))
  160.      (win1 (next-window nil 'foo t t))
  161.      (win win1)
  162.      (first t)
  163.      (ret nil)
  164.      )
  165.     (if (null buf)
  166.     nil
  167.       (while (or
  168.           (and first win)
  169.           (not (or first (equal win win1)))
  170.           )
  171.     (setq first nil)
  172.     (if (equal
  173.          buf
  174.          (window-buffer win))
  175.         (setq ret (cons win ret)))
  176.     (setq win (next-window win t t t))
  177.     )
  178.       ret)))
  179.  
  180. (defun eos::dbx-process ()
  181.   ;; Returns nil, or the corresponding process where to insert
  182.   (let ((pl (process-list))
  183.     (found-proc nil)
  184.     )
  185.     (while (and pl (null found-proc))
  186.       (let* ((proc (car pl))
  187.          (name (process-name proc))
  188.          )
  189.     (if (and (>= (length name) 3)
  190.          (equal (substring name 0 3) "Eos"))
  191.         (setq found-proc proc)
  192.       (setq pl (cdr pl))
  193.       )
  194.     ))
  195.     found-proc
  196.     ))
  197.  
  198. (defun eos::insert-echo (process string)
  199.   (if (null process)
  200.       nil
  201.     (save-excursion
  202.       (set-buffer (process-buffer process))
  203.       (goto-char (point-max))
  204. ;;      (let ((beg (point)))
  205. ;;    (insert-before-markers string))
  206.       (insert-before-markers string)
  207.       (if (process-mark process)
  208.       (set-marker (process-mark process) (point-max))))
  209.     (if (eq (process-buffer process)
  210.         (current-buffer))
  211.     (goto-char (point-max)))
  212.     ))
  213.  
  214.  
  215. (defun eos::insert-on-debugger-buffer (msg rdonly face &optional previous-command)
  216.   ;; will insert MSG at end of debugger buffer with RDONLY property and with FACE. 
  217.   ;; If PREVIOUS-COMMAND is given, the newly created extent will be doubly linked into this one
  218.   ;; using 'previous-command and 'next-command properties
  219.   (save-window-excursion
  220.   (let ((fr (selected-frame))
  221.     (buf (current-buffer))
  222.     (xt nil))
  223.     (eos::ensure-debugger-buffer)
  224.     (toggle-read-only -1)        ; not read-only 
  225.     (eos::insert-echo (eos::dbx-process) msg)
  226.     (setq xt (eos::insert-string-as-extent msg rdonly face))
  227.     (if previous-command
  228.     (progn
  229.       (set-extent-property xt 'previous-command previous-command)
  230.       (set-extent-property previous-command 'next-command xt)
  231.       ))
  232.     (toggle-read-only 1)        ; now read-only 
  233.     (switch-to-buffer buf)
  234.     (select-frame fr)
  235.     xt
  236.   ))
  237.   )
  238.  
  239. (defun eos::insert-string-as-extent (msg rdonly face)
  240.   ;; insert MSG as a extent with RDONLY and FACE.  Returns the extent
  241.   (let ((here nil)
  242.     (xt nil))
  243.     (goto-char (point-max))
  244.     (setq here (point))
  245.     (insert msg)
  246.     (setq xt (make-extent here (point) nil))
  247.     (if rdonly
  248.     (progn
  249.       (set-extent-property xt 'read-only t)
  250.       (set-extent-property xt 'duplicable nil)
  251.       ))
  252.     (set-extent-face xt face)
  253.     (eos::synchronize-debugger-buffer)
  254.     xt
  255.     ))
  256.  
  257.  
  258. (require 'comint)
  259.  
  260. (defvar eos::dbx-program "dbx")
  261. (defvar eos::dbx-switches (list "-editor"))
  262.  
  263. (defun eos::expand-file-name (file)
  264.   ;; expand file name depending on first character
  265.   (cond
  266.    ((null file)
  267.     nil)
  268.    ((eq (elt file 0) ?~)
  269.     (expand-file-name file))
  270.    ((eq (elt file 0) ?$)
  271.     (substitute-in-file-name file))
  272.    (t file)))
  273.  
  274. (defun eos::read-dbx-request (program switches)
  275.   ;; will prompt to the user with PROGRAM and SWITCHES, let her modify this
  276.   ;; and then will read the result and split it into program and switches.
  277.   (let* ((prompt
  278.       (concat program " " (mapconcat 'identity switches " ")))
  279.      (ret (read-from-minibuffer "Run dbx as: " prompt))
  280.      (ret2 (split-string ret " ")))
  281.     ;; some testing
  282.     (cons (car ret2) (cdr ret2))
  283.   ))
  284.  
  285. (defun eos::dbx ()
  286. ;; Run an inferior dbx -editor process, with I/O through buffer *Eos Dbx*.
  287. ;; If buffer exists but dbx process is not running, make new dbx.
  288. ;; If buffer exists and dbx process is running, 
  289. ;; just switch to buffer `*Eos Dbx*'.
  290.   (let ((buffer "*Eos Dbx*")
  291.     (buffer-name "Eos Dbx")
  292.     (input nil))
  293.     (cond ((not (comint-check-proc buffer))
  294.        (setq input (eos::read-dbx-request eos::dbx-program
  295.                           eos::dbx-switches))
  296.        (setq eos::dbx-program (car input))
  297.        (setq eos::dbx-switches (cdr input))
  298.        (message "Starting Dbx subprocess")
  299.        (setq buffer
  300.          (set-buffer
  301.           (apply 'make-comint 
  302.              buffer-name
  303.              (eos::expand-file-name eos::dbx-program)
  304.              nil
  305.              (mapcar 'eos::expand-file-name eos::dbx-switches))))
  306.        (comint-mode)
  307.        (if (and (eq (device-type (frame-device (selected-frame))) 'tty)
  308.             (eq eos::key-mode 'none)
  309.             (yes-or-no-p 
  310.              "Do you want the prefix map activated?"))
  311.            (eos::set-key-mode 'prefix))
  312.        (setq eos::dbx-or-debugger 'dbx)
  313.        (setq eos::dbx-buffer (current-buffer))
  314.        (make-local-variable 'kill-buffer-hook)
  315.        (setq kill-buffer-hook
  316.          (list (function (lambda ()
  317.                    (cond
  318.                     ((null (eos::dbx-process)) t)
  319.                     ((not (eq (process-status (eos::dbx-process)) 'run)) t)
  320.                     ((yes-or-no-p
  321.                       "Warning! Killing this buffer will kill a dbx process, proceed? ")
  322.                      (eos::internal-clear-annotations t t t t))
  323.                     (t (error "kill-buffer aborted!")))
  324.                    ))))
  325.        )
  326.       (t
  327.        (message "Reusing existing dbx buffer and dbx process")))
  328.     (switch-to-buffer buffer)
  329.   ))
  330.  
  331.  
  332. ;; Actions to start a debugger in the background.
  333.  
  334. (defvar eos::debugger-process nil
  335.   "Debugger process for the background.  Only one per XEmacs")
  336.  
  337. (defvar eos::dbx-or-debugger nil)
  338.  
  339. (defun eos::start-debugger ()
  340.   "Start an \"debugger -editor\" in the background. Will ask for confirmation if
  341. XEmacs somehow believes there is already one running"
  342.   (interactive)
  343.   (if (and (or (not (processp eos::debugger-process))
  344.            (not (eq (process-status eos::debugger-process) 'run))
  345.            (yes-or-no-p
  346.         "Warning! XEmacs believes there already is a debugger -editor, proceed? "))
  347.        (or (not (eos::dbx-process))
  348.            (not (eq (process-status (eos::dbx-process)) 'run))
  349.            (yes-or-no-p
  350.         "Warning! XEmacs believes there already is a dbx -editor, proceed? ")))
  351.       (progn
  352.     (setq eos::debugger-process
  353.           (start-process "*eos debugger*" nil "debugger" "-editor"))
  354.     (message "Starting Debugger subprocess")
  355.     (eos::select-debugger-frame (selected-frame))
  356.     (setq eos::dbx-or-debugger 'debugger)
  357.     )))
  358.  
  359. ;; Ditto for dbx.
  360.  
  361. (defun eos::start-dbx ()
  362.   "Start an \"dbx -editor\" as a subprocess. Will ask for confirmation if
  363. XEmacs somehow believes there is already one running"
  364.   (interactive)
  365.   (if (and (or (not (processp eos::debugger-process))
  366.            (not (eq (process-status eos::debugger-process) 'run))
  367.            (yes-or-no-p
  368.         "Warning! XEmacs believes there already is a debugger -editor, proceed? "))
  369.        (or (not (eos::dbx-process))
  370.            (not (eq (process-status (eos::dbx-process)) 'run))
  371.            (yes-or-no-p
  372.         "Warning! XEmacs believes there already is a dbx -editor, proceed? ")))
  373.       (progn
  374.     (eos::select-debugger-frame (selected-frame))
  375.     (eos::dbx)
  376.     )))
  377.  
  378.  
  379. ;;
  380. ;; Communication commands
  381. ;;
  382.  
  383. (defun eos::spider-do-callback (msg pat)
  384.   ;; Callback after processing a spider_do request
  385.   (eos::insert-on-debugger-buffer
  386.    (format "%s" (get-tooltalk-message-attribute msg 'arg_val 2))
  387.    t
  388.    (get-face 'bold))
  389.   (destroy-tooltalk-message msg)
  390.   )
  391.  
  392. (defvar eos::last-command-was-print nil "(eos:: internal)")
  393.  
  394. (defun eos::spro_spider_output (msg pat)
  395.   ;; For spider output
  396.   (let ((s (get-tooltalk-message-attribute msg 'arg_val 1))
  397.     (err (get-tooltalk-message-attribute msg 'arg_val 2))
  398.     )
  399.     (message (format "%s" s))
  400.     (eos::insert-on-debugger-buffer (format "%s" s)
  401.                     t
  402.                     (get-face 'default))
  403.     (if (and err (not (string-equal err "")))
  404.     (eos::insert-on-debugger-buffer
  405.      (insert (format "STDERR> %s" err))
  406.      t
  407.      (get-face 'default))
  408.       )
  409.     (destroy-tooltalk-message msg)))
  410.  
  411. (defun eos::spro_spider_output-common (msg pat)
  412.   ;; For spider output
  413.   (if eos::last-command-was-print
  414.       (eos::spro_spider_print_output msg pat)
  415.     (eos::spro_spider_output msg pat)))
  416.  
  417. (defmacro eos::spider-tt-args (cmd spider-id clique-id)
  418.   (` (list
  419.       'class TT_REQUEST
  420.       'address TT_HANDLER
  421.       'scope TT_SESSION
  422.       'handler (, spider-id)
  423.       'op "SPRO_SPIDER_DO"
  424.       'callback 'eos::spider-do-callback
  425.       'args (list
  426.          (list 'TT_IN (, clique-id) "Context_ID")
  427.          (list 'TT_IN (, cmd) "string")
  428.          (list 'TT_OUT))
  429.       )))
  430.  
  431. (defun eos::send-spider-do-msg (cmd spider-id clique-id)
  432.   ;; Send CMD, a string, to SPIDER-ID, using CLIQUE-ID
  433.   (let ((msg (make-tooltalk-message
  434.           (eos::spider-tt-args cmd spider-id clique-id))))
  435.     (setq eos::last-command
  436.       (eos::insert-on-debugger-buffer
  437.        cmd
  438.        t
  439.        (get-face 'italic)
  440.        eos::last-command))
  441.     (setq eos::current-command eos::last-command)
  442.     (send-tooltalk-message msg)
  443.     (destroy-tooltalk-message msg)
  444.     ))
  445.  
  446. (defvar eos::no-connection-box
  447.       '("XEmacs does not know the ID of a debugger to connect to.
  448. You may need to reissue a debug or attach command from the debugger.
  449. Consult the introduction to Eos (Help->SPARCworks...) for more details."
  450.            ["Dismiss" (message "Command aborted") t]))
  451.  
  452. (defun eos::send-spider-current-do-msg (cmd)
  453.   ;; Send CMD to the current dbx engine using the current debugger clique;
  454.   ;;The cmd ends in a new-line.
  455.   (if (null eos::current-debugger-clique-id)
  456.       (popup-dialog-box eos::no-connection-box)
  457.     (eos::send-spider-do-msg cmd
  458.                  eos::current-dbx-proc-id
  459.                  eos::current-debugger-clique-id)))
  460.  
  461. (defun eos::dbx-cmd (arg) 
  462.   "Send CMD to the current dbx engine using the current debugger clique;
  463. The cmd does not end in a new-line; a new-line will be added"
  464.   (interactive "sDbx cmd: ")
  465.   (eos::send-spider-current-do-msg (concat arg "\n")))
  466.  
  467.  
  468. ;;
  469. ;; Extra patterns
  470.  
  471. (defvar eos::dbx-extra-pattern-list nil)
  472.  
  473. (defun eos::debugger-extra-startup ()
  474.   ;; Actions to do at startup for eos-debugger-extra.el
  475.     (setq eos::dbx-extra-pattern-list    ; list of extra TT patterns
  476.       (eos::create-debugger-extra-patterns))
  477.     (eos::ensure-available-print-frame)
  478.     (eos::define-prefix-map)        ; initialize keymap
  479.   )
  480.  
  481. (defun eos::create-debugger-extra-patterns ()
  482.   ;; returns a list of patterns
  483.   (list
  484.    (make-an-observer "SPRO_SPIDER_OUTPUT" 'eos::spro_spider_output-common)
  485.    ))
  486.  
  487. (defun eos::register-debugger-extra-patterns ()
  488.   ;; register additional dbx patterns
  489.     (mapcar 'register-tooltalk-pattern eos::dbx-extra-pattern-list))
  490.  
  491. (defun eos::unregister-debugger-extra-patterns ()
  492.   ;; unregister additional dbx patterns
  493.   (mapcar 'unregister-tooltalk-pattern eos::dbx-extra-pattern-list))
  494.  
  495. ;;
  496. ;; Common commands
  497. ;;
  498.  
  499.  
  500. (defun eos::type () (interactive)
  501.   (if (eq eos::dbx-or-debugger 'debugger)
  502.       (call-interactively 'eos::dbx-cmd)
  503.     (if (buffer-live-p eos::dbx-buffer)
  504.     (switch-to-buffer eos::dbx-buffer)
  505.       (message "no dbx subprocess buffer known"))))
  506.  
  507. (defun eos::run () (interactive) (eos::dbx-cmd "run"))
  508. (defun eos::fix () (interactive) (eos::dbx-cmd "fix"))
  509. (defun eos::build () (interactive) (eos::dbx-cmd "make"))
  510.  
  511. (defun eos::cont () (interactive) (eos::dbx-cmd "cont"))
  512. (defun eos::cont-and-dismiss () (interactive)
  513.   (eos::dismiss-print-frame) (eos::cont))
  514. (defun eos::clear-all () (interactive) (eos::dbx-cmd "clear"))
  515. (defun eos::next () (interactive) (eos::dbx-cmd "next"))
  516. (defun eos::next-and-dismiss () (interactive)
  517.   (eos::dismiss-print-frame) (eos::next))
  518. (defun eos::step () (interactive) (eos::dbx-cmd "step"))
  519. (defun eos::step-and-dismiss () (interactive)
  520.   (eos::dismiss-print-frame) (eos::step))
  521. (defun eos::step-up () (interactive) (eos::dbx-cmd "step up"))
  522.  
  523. (defun eos::up () (interactive)  (eos::dbx-cmd "up" ))
  524. (defun eos::down () (interactive) (eos::dbx-cmd "down"))
  525. (defun eos::pop () (interactive) (eos::dbx-cmd "pop"))
  526.  
  527.  
  528. (defun eos::stop-at ()
  529.   (interactive)
  530.   (let ((name (buffer-file-name)))
  531.     (if (null name) (error "Buffer has no associated file"))
  532.     (eos::dbx-cmd
  533.      (format "stop at \"%s\":%d" name (eos::line-at (point))))
  534.     ))
  535.  
  536. (defun eos::clear-at ()
  537.   (interactive)
  538.   (let ((name (buffer-file-name)))
  539.     (if (null name) (error "Buffer has no associated file"))
  540.     (eos::dbx-cmd
  541.      (format "clear \"%s\":%d" name (eos::line-at (point))))
  542.      ))
  543.  
  544. (defun eos::stop-in ()
  545.   (interactive)
  546.   (eos::dbx-cmd
  547.    (format "stop in %s"
  548.        (if (eq 'x (device-type (selected-device)))
  549.            (x-get-selection)
  550.          (buffer-substring (point) (mark)))
  551.        ))
  552.    (setq zmacs-region-stays t))
  553.  
  554. (defun eos::func ()
  555.   (interactive)
  556.   (eos::dbx-cmd
  557.    (format "func %s"
  558.        (if (eq 'x (device-type (selected-device)))
  559.            (x-get-selection)
  560.          (buffer-substring (point) (mark)))
  561.        ))
  562.   (setq zmacs-region-stays t))
  563.  
  564. (defun eos::cont-to ()
  565.   (interactive)
  566.   (let ((name (buffer-file-name)))
  567.     (if (null name) (error "Buffer has no associated file"))
  568.     (eos::dbx-cmd
  569.      (format "stop at \"%s\":%d -temp; cont" name (eos::line-at (point))))
  570.     ))
  571.  
  572. (defun eos::print-normal ()
  573.   (interactive)
  574.   (eos::dbx-cmd
  575.    (format "print  %s"
  576.        (if (eq 'x (device-type (selected-device)))
  577.            (x-get-selection)
  578.          (buffer-substring (point) (mark)))
  579.        ))
  580.   (setq zmacs-region-stays t))
  581.  
  582. (defun eos::print*-normal ()
  583.   (interactive)
  584.   (eos::dbx-cmd
  585.    (format "print  *(%s)"
  586.        (if (eq 'x (device-type (selected-device)))
  587.            (x-get-selection)
  588.          (buffer-substring (point) (mark)))
  589.        ))
  590.   (setq zmacs-region-stays t))
  591.  
  592. ;; specialization for print commands
  593.  
  594. (defun eos::send-spider-print-msg (expr)
  595.   ;; Print EXPR using separate frame
  596.   (setq eos::last-command-was-print t)
  597.   (eos::dbx-cmd (format "print %s" expr)))
  598.  
  599. (defun eos::send-spider-print*-msg (expr)
  600.   ;; Send *EXPR using separate frame
  601.   (setq eos::last-command-was-print t)
  602.   (eos::dbx-cmd (format "print *(%s)" expr)))
  603.  
  604. (defun eos::print () (interactive)
  605.  (eos::send-spider-print-msg
  606.   (if (eq 'x (device-type (selected-device)))
  607.       (x-get-selection)
  608.     (buffer-substring (point) (mark)))
  609.   )
  610.  (setq zmacs-region-stays t))
  611.  
  612. (defun eos::print* () (interactive)
  613.  (eos::send-spider-print*-msg
  614.   (if (eq 'x (device-type (selected-device)))
  615.       (x-get-selection)
  616.     (buffer-substring (point) (mark)))
  617.   )
  618.  (setq zmacs-region-stays t))
  619.  
  620.  
  621. ;;
  622. ;;
  623. ;; Print on separate frame
  624.  
  625.  
  626. (defun eos::buffer-line-size (buffer)
  627.   (interactive)
  628.   (or (bufferp buffer)
  629.       (setq buffer (current-buffer)))
  630.   (save-excursion
  631.     (switch-to-buffer buffer)
  632.     (eos::line-at (point-max))))
  633.  
  634. ;;
  635. ;; Handling of a collection of print frames
  636. ;; (currently only one)
  637.  
  638. (defvar eos::print-frame nil "Frame for prints")
  639. (defvar eos::print-buffer " *Eos Print Output*" "Buffer for prints")
  640.  
  641. (defun eos::new-available-print-frame()
  642.   ;; returns an available print frame
  643.   ;; currently just returns the one frame
  644.   (require 'eos-toolbar  "sun-eos-toolbar")
  645.   (let ((scr (selected-frame))
  646.     (buf (current-buffer)))
  647.  
  648.     ;; create frames
  649.     (if (and 
  650.      (frame-live-p eos::print-frame)
  651.      (or (not (frame-live-p eos::debugger-frame))
  652.          (not (eq eos::print-frame
  653.               eos::debugger-frame))))
  654.     (progn
  655.       (make-frame-visible eos::print-frame)
  656.       eos::print-frame)
  657.       (setq eos::print-frame (make-frame))
  658.       ;; no modeline visible...
  659.       (set-face-background 'modeline 
  660.                (face-background (get-face 'default))
  661.                eos::print-frame)
  662.       (set-face-foreground 'modeline 
  663.                (face-background (get-face 'default))
  664.                eos::print-frame)
  665.       ;; there is redundancy below.
  666.       (select-frame eos::print-frame)
  667.       (switch-to-buffer eos::print-buffer)
  668.       (set-buffer-menubar nil)
  669.       (add-spec-to-specifier (eos::toolbar-position) eos::print-toolbar (selected-frame))
  670.       (add-spec-to-specifier has-modeline-p nil (selected-frame))
  671.       (select-frame scr)
  672.       (switch-to-buffer buf)
  673.       eos::print-frame
  674.       )))
  675.  
  676. ;; set delete-frame-hook and check for this frame... then do 
  677.  
  678.  
  679.  
  680. (defun eos::ensure-available-print-frame ()
  681.   ;; ensures that there is at least one available print frame
  682.   t)
  683.  
  684. (defun eos::show-print-frame ()
  685.   (interactive)
  686.   (setq eos::print-frame (eos::new-available-print-frame))
  687.   (select-frame eos::print-frame)
  688.   (switch-to-buffer eos::print-buffer)
  689.   (set-frame-height eos::print-frame
  690.              (+ 1 (eos::buffer-line-size eos::print-buffer)))
  691.   (goto-char (point-min))
  692.     )
  693.  
  694. (defun eos::dismiss-print-frame ()
  695.   (interactive)
  696.   (if (frame-live-p eos::print-frame)
  697.       (progn
  698.     (make-frame-invisible eos::print-frame)
  699.     (select-frame (car (visible-frame-list))))))
  700. ;;
  701. ;; print output
  702. ;;
  703.  
  704. (defun eos::spro_spider_print_output (msg pat)
  705.   ;; For spider print output (switched with spro_spider_output
  706.   (let ((buf (current-buffer))
  707.     (scr (selected-frame)))
  708.     (save-excursion            ; does not work in callbacks?
  709.       (switch-to-buffer eos::print-buffer)
  710.       (delete-region (point-min) (point-max))
  711.       (goto-char (point-max))
  712.       (insert (format "%s" (get-tooltalk-message-attribute msg
  713.                                'arg_val 1)))
  714.       (let ((err (get-tooltalk-message-attribute msg
  715.                          'arg_val 2)))
  716.     (if (and err (not (string-equal err "")))
  717.         (insert (format "STDERR> %s" err))))
  718.       (eos::show-print-frame)
  719.       (select-frame scr)
  720.       (switch-to-buffer buf)
  721.       )
  722.     (destroy-tooltalk-message msg)
  723.     (setq eos::last-command-was-print nil)
  724.     ))
  725.  
  726.  
  727. ;; User interface
  728.  
  729. (defvar eos::prefix-map (make-keymap))
  730.  
  731. (defun eos::define-prefix-map ()
  732.  
  733.   (define-key eos::prefix-map "%" 'eos::dbx-cmd)
  734.   (define-key eos::prefix-map "r" 'eos::run)
  735.   (define-key eos::prefix-map "f" 'eos::fix)
  736.  
  737.   (define-key eos::prefix-map "p" 'eos::print)
  738.   (define-key eos::prefix-map "\C-p" 'eos::print*)
  739.  
  740.   (define-key eos::prefix-map "c" 'eos::cont)
  741.   (define-key eos::prefix-map "b" 'eos::stop-at)
  742.   (define-key eos::prefix-map "\C-b" 'eos::clear-at)
  743.  
  744.   (define-key eos::prefix-map "n" 'eos::next)
  745.   (define-key eos::prefix-map "s" 'eos::step)
  746.   (define-key eos::prefix-map "\C-s" 'eos::step-up)
  747.  
  748.   (define-key eos::prefix-map "u" 'eos::up)
  749.   (define-key eos::prefix-map "d" 'eos::down)
  750.  
  751. )
  752.  
  753. (defun eos::set-key-mode (mode)
  754.   ;; Set the key MODE to either 'none, 'prefix, or 'function
  755.   (setq eos::key-mode mode)
  756.   (cond
  757.    ((eq eos::key-mode 'none)
  758.     (define-key global-map "\C-cd" nil)
  759.     (eos::remove-function-keys)
  760.     (add-submenu nil (append '("SPARCworks") eos::short-menu))
  761.     )
  762.    ((eq eos::key-mode 'prefix)
  763.     (define-key global-map "\C-cd" eos::prefix-map)
  764.     (eos::remove-function-keys)
  765.     (add-submenu nil (append '("SPARCworks") eos::long-menu))
  766.     )
  767.    ((eq eos::key-mode 'function)
  768.     (define-key global-map "\C-cd" nil)
  769.     (eos::add-function-keys)
  770.     (add-submenu nil (append '("SPARCworks") eos::long-menu))
  771.     )
  772.    (t
  773.     (error "unimplemented")
  774.     )))
  775.  
  776. (defun eos::add-function-keys ()
  777.   (interactive)
  778.  
  779.   ;;
  780.   (global-set-key [f6] 'eos::dbx-cmd)
  781.   (global-set-key [(control f6)] 'eos::run)
  782.   (global-set-key [(shift f6)] 'eos::fix)
  783.   ;;
  784.   (global-set-key [f7] 'eos::print)
  785.   (global-set-key [(control f7)] 'eos::print*)
  786.   (global-set-key [(shift f7)] 'eos::dismiss-print-frame)
  787.   ;;
  788.   (global-set-key [f8] 'eos::cont)
  789.   (global-set-key [(control f8)] 'eos::stop-at)
  790.   (global-set-key [(shift f8)] 'eos::clear-at)
  791.   ;;
  792.   (global-set-key [f9] 'eos::next)
  793.   (global-set-key [(control f9)] 'eos::step)
  794.   (global-set-key [(shift f9)] 'eos::step-up)
  795.   ;;
  796.   )
  797.  
  798. (defun eos::remove-function-keys ()
  799.   (interactive)
  800.  
  801.   ;;
  802.   (global-set-key [f6] nil)
  803.   (global-set-key [(control f6)] nil)
  804.   (global-set-key [(shift f6)] nil)
  805.   ;;
  806.   (global-set-key [f7] nil)
  807.   (global-set-key [(control f7)] nil)
  808.   (global-set-key [(shift f7)] nil)
  809.   ;;
  810.   (global-set-key [f8] nil)
  811.   (global-set-key [(control f8)] nil)
  812.   (global-set-key [(shift f8)] nil)
  813.   ;;
  814.   (global-set-key [f9] nil)
  815.   (global-set-key [(control f9)] nil)
  816.   (global-set-key [(shift f9)] nil)
  817.   ;;
  818.   )
  819.  
  820. ;; Provides popup access
  821.  
  822. (defvar eos::popup-mode nil)
  823. (defvar eos::saved-global-popup-menu nil)
  824.  
  825. (defun eos::toggle-popup-menu ()
  826.   ;; Toggle whether to use or not popup menus for SPARCworks
  827.   (interactive)
  828.   (if eos::popup-mode
  829.       (setq global-popup-menu eos::saved-global-popup-menu)
  830.     (eos::push-popup-menu))
  831.   (setq eos::popup-mode (null eos::popup-mode))
  832.   )
  833.  
  834. (defun eos::push-popup-menu ()
  835.   (setq eos::saved-global-popup-menu global-popup-menu)
  836.   (setq global-popup-menu
  837.     (append
  838.      '("SPARCworks Command"
  839.        ["Stop At" eos::stop-at t]
  840.        ["Clear At" eos::clear-at t]
  841.        ["Stop In" eos::stop-in t]
  842.        ["Cont To" eos::cont-to t]
  843.        ["Print" eos::print t]
  844.        ["Print*" eos::print* t]
  845.        "---"
  846.        ["Read a Dbx Command" eos::dbx-cmd t]
  847.        "---")
  848.      (list
  849.       eos::saved-global-popup-menu))
  850.     ))
  851.  
  852. (provide 'eos-debugger)
  853.  
  854. ;;; sun-eos-debugger.el ends here
  855.